library(ggplot2)
library(dplyr)
library(caret)
library(cluster)
library(klaR)
library(clustMixType)
library(data.table)
library(factoextra)
library(tidyr)
library(Rtsne)
library(compareGroups)
library(gridExtra)
library(reshape)

Preprocesado de los datos

Leer dataset y mostrar algunas filas

BlackFriday <- read.csv("BlackFriday.csv")
dim(BlackFriday)
## [1] 537577     12
head(BlackFriday)

Cada fila describe una compra de un producto hecha por un cliente determinado

Descripción de atributos

  • User_ID: Cateǵorico
  • Product_ID: Categórico
  • Gender: Categórico (M,F)
  • Age: Categórico (0-17, 18-25, 26-35, 36-45, 46-50, 51-55, 55+)
  • Occupation: Categórico (0, 1, 2, …, 19, 20)
  • City_Category: Categórico (A, B, C)
  • Stay_In_Current_City_Years: Cateǵorico (0, 1, 2, 3, 4+)
  • Marital_Status: Categórico (0, 1)
  • Product_Category_1/2/3: Categórico (1, 2, …, 17, 18)
  • Purchase: Numérico

Algunas columnas categóricas no son reconocidas como factors (User_ID, Occupation, Product_Category, Marital_Status)

# Factorizar columnas categóricas
BlackFriday$User_ID <- factor(BlackFriday$User_ID)
BlackFriday$Occupation <- factor(BlackFriday$Occupation)
BlackFriday$Marital_Status <- factor(BlackFriday$Marital_Status)
BlackFriday$Product_Category_1 <- factor(BlackFriday$Product_Category_1)
BlackFriday$Product_Category_2 <- factor(BlackFriday$Product_Category_2)
BlackFriday$Product_Category_3 <- factor(BlackFriday$Product_Category_3)

Generación de atributos

Como queremos hacer clustering sobre los clientes, tenemos que agrupar todas las transacciones de cada cliente en una única fila. Unificamos y creamos nuevos atributos basados en ésta agrupación de transacciones:

  • Atributos de perfil de cliente (User_ID, Gender, Age, Occupation, City_Category, Stay_In_Current_City_Years, Marital_Status). Eliminamos Product_ID.

  • Número de elementos comprados por cada categoría de producto por cada cliente (18 nuevos atributos)

  • Gasto total de cada cliente

Perfil de usuario

En primer lugar, creamos un dataframe solamente con el perfil de usuario, eliminando User_ID duplicados. Trataremos la información de compras de productos después

# Seleccionar únicamente columnas de perfil de usuario
BlackFriday_Clustering <- dplyr::select(BlackFriday, User_ID, Gender, Age, Occupation, City_Category, Stay_In_Current_City_Years, Marital_Status)

# Eliminar duplicados
BlackFriday_Clustering <- distinct(BlackFriday_Clustering)

La edad y el número de años en la ciudad pueden ser consideradas variables númericas (Age, Stay_In_Current_City_Years). Aunque vienen especificadas de forma categórica, nos interesa que nuestro modelo sea capaz de reconocer que, por ejemplo, dos personas de 18 y 55 años son menos parecidas que dos de 30 y 40. Si lo expresamos de forma categórica, la distancia entre todos los grupos será la misma. Por lo tanto, vamos a usar para la edad el valor medio de cada grupo. Para el número de años en la ciudad consideramos el 4+ como un 4.

# Convertir Age & Stay_In_Current_City_Years a atributos numéricos
# Age
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='0-17'] <- 15
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='18-25'] <- 22
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='26-35'] <- 30
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='36-45'] <- 40
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='46-50'] <- 48
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='51-55'] <- 53
BlackFriday_Clustering$Age_Int[BlackFriday_Clustering$Age=='55+'] <- 60
BlackFriday_Clustering$Age <- NULL

# Stay_In_Current_City_Years
BlackFriday_Clustering$Stay_In_Current_City_Years <- 
  as.numeric(BlackFriday_Clustering$Stay_In_Current_City_Years) - 1

Información de compras

Añadimos la información de compras a cada usuario (categoría de producto y gasto total)

Para las categorías de producto existen varias opciones:

  • Generar 18 nuevos atributos que expresen el número de items comprado por cada categoría de producto
  • Generar 18 nuevos atributos que expresen la suma total gastada por categoría de producto
# Número de items comprados por cada categoría de producto
purchase_category <- dplyr::select(BlackFriday, User_ID, Product_Category_1, Purchase) %>%
  group_by(User_ID, Product_Category_1) %>%
  summarise(Purchase = length(Purchase)) %>%
  spread(key=Product_Category_1, value=Purchase, fill=0) %>%
  ungroup()

# Renombrar columnas
for (n in names(purchase_category)[-1]){
  new_colname <- paste("Product_Category_",n,sep="")
  names(purchase_category)[names(purchase_category)==paste(n)] <- paste(new_colname)
}

BlackFriday_Clustering <- merge(BlackFriday_Clustering,purchase_category, by="User_ID")
head(purchase_category)
# Suma total gastada por categoría de producto

# purchase_category <- dplyr::select(BlackFriday,User_ID,Product_Category_1,Purchase) %>%
#   group_by(User_ID,Product_Category_1) %>%
#   summarise(Purchase = sum(Purchase)) %>%
#   spread(key=Product_Category_1, value=Purchase, fill=0) %>%
#   ungroup()
# 
# # Rename columns
# for (n in names(purchase_category)[-1]){
#   new_colname <- paste("Product_Category_",n,sep="")
#   names(purchase_category)[names(purchase_category)==paste(n)] <- paste(new_colname)
# }
# BlackFriday_Clustering <- merge(BlackFriday_Clustering,purchase_category, by="User_ID")
# head(purchase_category)

Generamos una columna de gasto total de cada cliente

# Gasto total de cada cliente
purchase_sum <- aggregate(Purchase ~ User_ID, data=BlackFriday, sum)
BlackFriday_Clustering <- merge(BlackFriday_Clustering,purchase_sum, by="User_ID")

Eliminamos User_ID y visualizamos el dataframe transformado para clustering

BlackFriday_Clustering$User_ID <- NULL
head(BlackFriday_Clustering)

Clustering

Una vez tenemos los datos agrupados por cliente, podemos hacer clustering para intentar identificar grupos con clientes similares. Dado que tenemos una mezcla de variables categóricas y numéricas, consideramos varias opciones:

K-means

Para utilizar el K-means creamos un nuevo dataframe (BlackFriday_ohe) con las variables categóricas codificadas one-hot.

# One-hot encoding
dmy <- dummyVars(" ~ .", data = BlackFriday_Clustering)
BlackFriday_ohe <- data.frame(predict(dmy, newdata = BlackFriday_Clustering))

# Eliminar una de las columnas de variables que solo tengan dos valores (Gender and Marital_Status)
BlackFriday_ohe$Gender.F <- NULL
BlackFriday_ohe$Marital_Status.0 <- NULL

Normalizamos columnas numéricas. Como su rango es mayor, las distancias pueden ser grandes. Si no las normalizamos tendrán mayor influencia que las demás variables categóricas codificadas.

# BlackFriday_ohe <- rescaler(BlackFriday_ohe, "range")
cols_to_scale <- grep( "Product_Category", names(BlackFriday_ohe),value=T)
cols_to_scale <- c(cols_to_scale, "Age_Int","Stay_In_Current_City_Years","Purchase" )
BlackFriday_ohe <- BlackFriday_ohe %>% mutate_each_(funs(scale(.) %>% as.vector),                     vars=cols_to_scale)
## `mutate_each()` is deprecated.
## Use `mutate_all()`, `mutate_at()` or `mutate_if()` instead.
## To map `funs` over a selection of variables, use `mutate_at()`

Visualizar dataframe BlackFriday_ohe para el K-means

head(BlackFriday_ohe)

Buscamos el número óptimo de clusters con el Elbow method (total within-cluster sum of square (wss))

wss <- 0
for (i in 1:15) {
  km.out <- kmeans(BlackFriday_ohe, centers = i, nstar=5)
  wss[i] <- km.out$tot.withinss
}
## Warning: did not converge in 10 iterations

## Warning: did not converge in 10 iterations
plot(1:15, wss, type = "b", xlab = "Number of Clusters",
     ylab = "Within groups sum of squares")

Visualización de los resultados en 2D en función del número de clusters. Se reduce la dimensionalidad usando PCA y se enfrentan las dos componentes principales

for (k in 3:6){
  km <- kmeans(BlackFriday_ohe, centers=k, nstar=5)
  fv <- fviz_cluster(km, geom = "point", data = BlackFriday_ohe) +  ggtitle(paste("2D Cluster solution (k=", k, ")", sep=""))
  plot(fv)
}

Escogemos 4 clusters como el mejor valor

k <- 4
reskm <- kmeans(BlackFriday_ohe, centers=k, nstar=5)
BlackFriday_Clustering$cluster_kmeans <- as.factor(reskm$cluster)

Se crea la función clusterAnalysis para intentar interpretar los resultados del clustering, identificando las características propias de cada grupo.

Primero se muestra una tabla con los distintos valores de atributos en cada cluster.

Como es difícil extraer conclusiones de las tablas, mostramos gráficas de la distribución de los valores de atributos en cada cluster.

Para las variables continuas usamos boxplots que muestran valor mínimo, primer cuartil, la mediana, la media, tercer cuartil y valor máximo.

Para las variables categóricas usamos Pie Charts.

boxplotBF <- function(df, clusterCol, attribute){
  ggplot(data = df, mapping= aes(x =  eval(parse(text=clusterCol)), y = eval(parse(text=attribute)), fill = eval(parse(text=clusterCol)))) +
  geom_boxplot(outlier.colour="black", outlier.shape=16, outlier.size=2) +
  stat_summary(fun.y=mean, geom="point", shape=23, size=4) +
  labs(title = attribute,  x=clusterCol , y = attribute)
}

pieChartBF <- function(df, clusterCol, attribute) {
  ggplot(data=df, aes(x=factor(1), stat='identity', fill=eval(parse(text=attribute)))) +
  theme(axis.text.x=element_blank(), axis.text.y=element_blank(), axis.ticks=element_blank()) +
  facet_wrap(~eval(parse(text=clusterCol)))+
  geom_bar(color="black",position = "fill") +
  coord_polar(theta="y") +
  labs(title = paste(attribute, " by cluster",sep="") ,  x="" , y = clusterCol, fill= attribute)
}
clusterAnalysis <- function(df, clusterCol){
  group<-compareGroups(as.formula(paste(clusterCol,"~.")),data=df, max.ylev=12, max.xlev = 21)
  clustab<-createTable(group)
  print(clustab)

  PurchaseCluster <- boxplotBF(BlackFriday_Clustering, clusterCol, 'Purchase')
  print(PurchaseCluster)
  
  AgeCluster <- boxplotBF(BlackFriday_Clustering, clusterCol, 'Age_Int')
  print(AgeCluster)
  StayCityCluster <-  boxplotBF(BlackFriday_Clustering, clusterCol, 'Stay_In_Current_City_Years')
  print(StayCityCluster)
  
  col_plot <- grep( "Product_Category", names(BlackFriday_Clustering),value=T)
  dat.m <- melt(BlackFriday_Clustering, id.vars=clusterCol, measure.vars=col_plot)
  ProdCatCluster <- ggplot(dat.m,aes(x=eval(parse(text=clusterCol)), y=value, color=variable)) +     
    geom_boxplot() +
    labs(title="Product Categories by cluster", x=paste(clusterCol), y= "Item count") +
    stat_summary(fun.y=mean, geom="point", shape=23, size=6) 
  print(ProdCatCluster)
  
  print(pieChartBF(BlackFriday_Clustering, clusterCol,'City_Category'))
  print(pieChartBF(BlackFriday_Clustering, clusterCol,'Gender'))
  print(pieChartBF(BlackFriday_Clustering, clusterCol,'Occupation'))
  print(pieChartBF(BlackFriday_Clustering, clusterCol,'Marital_Status'))
  
}

Análisis de resultados

clusterAnalysis(BlackFriday_Clustering,"cluster_kmeans")
## 
## --------Summary descriptives table by 'cluster_kmeans'---------
## 
## ________________________________________________________________________________________________________ 
##                                   1                2                3                4         p.overall 
##                                 N=1019           N=324           N=4285            N=263                 
## ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ 
## Gender:                                                                                         <0.001   
##     F                        272 (26.7%)       53 (16.4%)     1282 (29.9%)      59 (22.4%)               
##     M                        747 (73.3%)      271 (83.6%)     3003 (70.1%)      204 (77.6%)              
## Occupation:                                                                                        .     
##     0                        129 (12.7%)       34 (10.5%)      481 (11.2%)      44 (16.7%)               
##     1                         80 (7.85%)       20 (6.17%)      390 (9.10%)      27 (10.3%)               
##     2                         58 (5.69%)       9 (2.78%)       175 (4.08%)      14 (5.32%)               
##     3                         41 (4.02%)       9 (2.78%)       113 (2.64%)       7 (2.66%)               
##     4                        126 (12.4%)       41 (12.7%)      537 (12.5%)      36 (13.7%)               
##     5                         27 (2.65%)       7 (2.16%)       70 (1.63%)        7 (2.66%)               
##     6                         38 (3.73%)       15 (4.63%)      164 (3.83%)      11 (4.18%)               
##     7                         93 (9.13%)       28 (8.64%)      516 (12.0%)      32 (12.2%)               
##     8                         1 (0.10%)        1 (0.31%)       14 (0.33%)        1 (0.38%)               
##     9                         12 (1.18%)       2 (0.62%)       71 (1.66%)        3 (1.14%)               
##     10                        25 (2.45%)       10 (3.09%)      155 (3.62%)       2 (0.76%)               
##     11                        29 (2.85%)       7 (2.16%)       90 (2.10%)        2 (0.76%)               
##     12                        72 (7.07%)       28 (8.64%)      272 (6.35%)       4 (1.52%)               
##     13                        14 (1.37%)       2 (0.62%)       122 (2.85%)       2 (0.76%)               
##     14                        45 (4.42%)       17 (5.25%)      219 (5.11%)      13 (4.94%)               
##     15                        25 (2.45%)       14 (4.32%)      99 (2.31%)        2 (0.76%)               
##     16                        44 (4.32%)       15 (4.63%)      161 (3.76%)      15 (5.70%)               
##     17                        59 (5.79%)       43 (13.3%)      374 (8.73%)      15 (5.70%)               
##     18                        12 (1.18%)       1 (0.31%)       51 (1.19%)        3 (1.14%)               
##     19                        18 (1.77%)       6 (1.85%)       43 (1.00%)        4 (1.52%)               
##     20                        71 (6.97%)       15 (4.63%)      168 (3.92%)      19 (7.22%)               
## City_Category:                                                                                  <0.001   
##     A                        220 (21.6%)       67 (20.7%)      640 (14.9%)      118 (44.9%)              
##     B                        514 (50.4%)      134 (41.4%)      914 (21.3%)      145 (55.1%)              
##     C                        285 (28.0%)      123 (38.0%)     2731 (63.7%)       0 (0.00%)               
## Stay_In_Current_City_Years   1.84 (1.28)      1.79 (1.25)      1.87 (1.28)      1.87 (1.35)      0.769   
## Marital_Status:                                                                                  0.492   
##     0                        611 (60.0%)      192 (59.3%)     2465 (57.5%)      149 (56.7%)              
##     1                        408 (40.0%)      132 (40.7%)     1820 (42.5%)      114 (43.3%)              
## Age_Int                      34.2 (10.7)      34.3 (10.5)      35.8 (12.2)      34.6 (10.1)     <0.001   
## Product_Category_1           43.7 (28.0)      47.2 (32.6)      12.1 (14.5)      101 (38.0)       0.000   
## Product_Category_2           8.03 (5.78)      8.76 (5.63)      1.67 (2.34)      20.2 (9.25)      0.000   
## Product_Category_3           7.05 (6.58)      5.71 (7.35)      1.64 (2.80)      14.5 (9.65)      0.000   
## Product_Category_4           4.26 (4.41)      3.16 (3.55)      0.81 (1.43)      10.4 (7.28)      0.000   
## Product_Category_5           52.1 (30.7)      32.8 (27.6)      12.3 (13.2)      122 (44.3)       0.000   
## Product_Category_6           7.16 (4.74)      4.18 (4.01)      1.70 (2.38)      16.1 (7.72)      0.000   
## Product_Category_7           1.40 (2.39)      0.69 (1.41)      0.27 (0.88)      3.32 (4.10)     <0.001   
## Product_Category_8           38.3 (24.0)      23.0 (20.3)      9.30 (10.0)      98.1 (44.0)      0.000   
## Product_Category_9           0.00 (0.00)      1.00 (0.00)      0.00 (0.00)      0.30 (0.46)      0.000   
## Product_Category_10          1.79 (1.96)      1.45 (1.53)      0.42 (0.91)      3.54 (2.52)      0.000   
## Product_Category_11          7.10 (9.43)      8.02 (11.8)      1.74 (4.77)      25.3 (20.7)      0.000   
## Product_Category_12          1.48 (2.09)      0.77 (1.65)      0.28 (0.85)      3.47 (3.36)      0.000   
## Product_Category_13          2.05 (1.98)      1.45 (1.70)      0.36 (0.79)      5.15 (3.02)      0.000   
## Product_Category_14          0.55 (0.95)      0.21 (0.54)      0.10 (0.36)      1.71 (1.73)      0.000   
## Product_Category_15          1.83 (1.92)      3.17 (3.03)      0.43 (0.94)      5.54 (3.61)      0.000   
## Product_Category_16          3.11 (3.03)      1.92 (2.63)      0.75 (1.15)      10.2 (6.62)      0.000   
## Product_Category_17          0.19 (0.54)      0.18 (0.49)      0.04 (0.23)      0.59 (1.03)     <0.001   
## Product_Category_18          1.05 (1.80)      0.92 (1.79)      0.18 (0.68)      3.49 (3.36)      0.000   
## Purchase                   1661953 (581193) 1425576 (766195) 432200 (305060) 3841352 (1095676)   0.000   
## ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

K-Prototypes

La función kproto se puede aplicar directamente al dataframe inicial, ya que identifica las variables categóricas y numéricas.

Primero estudiamos el número óptimo de clusters

# No consideramos la columna de cluster añadida anteriormente por el kmeans
BlackFriday_kproto <- subset( BlackFriday_Clustering, select = -cluster_kmeans )
wss <- 0
for (i in 1:15) {
  km.out <- kproto(BlackFriday_kproto, i, nstar=1)
  wss[i] <- km.out$tot.withinss
}
plot(1:15, wss, type = "b", xlab = "Number of Clusters",
     ylab = "Within groups sum of squares")

Seleccionamos 4 clusters

reskproto <- kproto(BlackFriday_kproto, 4, nstar=5)
BlackFriday_Clustering$cluster_kproto <- as.factor(reskproto$cluster)

Análisis de resultados

Hay algunas variables sobre las que no se aprecian diferencias significativos entre los clusters al tener medias y distribuciones parecidas: - Age: Media 35 años - Stay_In_Current_City_Years: Media 1.8 años - Gender: 75% Hombre - Marital Status: Al 50% - Occupation: Dominan levemente las clases 0, 4, 7

Aún así, se pueden observar algunas características interesantes de cada cluster:

  • Cluster 1: Gasto medio 2500, Mayoría ciudad B, Media de 50 productos categorías 1,5,8
  • Cluster 2: Gasto medio 1000, Mitad ciudad C, Media de 30 productos categorías 1, 5
  • Cluster 3 (Más grande 3500 clientes): Gasto medio menor (310), Mayoría ciudad C, Pocos productos (5/10 categoría 1, 5).
  • Cluster 4 (Más pequeño 199 clientes): Mayor gasto 4200, Solo ciudad A y B, Media mayor a 100 productos categorías 1, 5, 8; Media mayor a 20 productos categorías 2, 20.
clusterAnalysis(BlackFriday_Clustering,'cluster_kproto')
## 
## --------Summary descriptives table by 'cluster_kproto'---------
## 
## ________________________________________________________________________________________________________ 
##                                   1               2                3                 4         p.overall 
##                                N=3497           N=677            N=1518            N=199                 
## ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ 
## Gender:                                                                                         <0.001   
##     F                       1126 (32.2%)     141 (20.8%)      360 (23.7%)       39 (19.6%)               
##     M                       2371 (67.8%)     536 (79.2%)      1158 (76.3%)      160 (80.4%)              
## Occupation:                                                                                        .     
##     0                        401 (11.5%)      87 (12.9%)      167 (11.0%)       33 (16.6%)               
##     1                        310 (8.86%)      44 (6.50%)      143 (9.42%)       20 (10.1%)               
##     2                        141 (4.03%)      42 (6.20%)       65 (4.28%)        8 (4.02%)               
##     3                        97 (2.77%)       25 (3.69%)       42 (2.77%)        6 (3.02%)               
##     4                        405 (11.6%)      95 (14.0%)      216 (14.2%)       24 (12.1%)               
##     5                        61 (1.74%)       20 (2.95%)       25 (1.65%)        5 (2.51%)               
##     6                        149 (4.26%)      24 (3.55%)       44 (2.90%)       11 (5.53%)               
##     7                        437 (12.5%)      79 (11.7%)      127 (8.37%)       26 (13.1%)               
##     8                        12 (0.34%)       1 (0.15%)        3 (0.20%)         1 (0.50%)               
##     9                        68 (1.94%)       4 (0.59%)        13 (0.86%)        3 (1.51%)               
##     10                       137 (3.92%)      7 (1.03%)        46 (3.03%)        2 (1.01%)               
##     11                       76 (2.17%)       19 (2.81%)       31 (2.04%)        2 (1.01%)               
##     12                       213 (6.09%)      33 (4.87%)      125 (8.23%)        5 (2.51%)               
##     13                       104 (2.97%)      2 (0.30%)        33 (2.17%)        1 (0.50%)               
##     14                       177 (5.06%)      36 (5.32%)       70 (4.61%)       11 (5.53%)               
##     15                       80 (2.29%)       18 (2.66%)       40 (2.64%)        2 (1.01%)               
##     16                       123 (3.52%)      39 (5.76%)       64 (4.22%)        9 (4.52%)               
##     17                       296 (8.46%)      48 (7.09%)      138 (9.09%)        9 (4.52%)               
##     18                       37 (1.06%)       6 (0.89%)        21 (1.38%)        3 (1.51%)               
##     19                       37 (1.06%)       12 (1.77%)       19 (1.25%)        3 (1.51%)               
##     20                       136 (3.89%)      36 (5.32%)       86 (5.67%)       15 (7.54%)               
## City_Category:                                                                                  <0.001   
##     A                        499 (14.3%)     176 (26.0%)      276 (18.2%)       94 (47.2%)               
##     B                        723 (20.7%)     428 (63.2%)      451 (29.7%)       105 (52.8%)              
##     C                       2275 (65.1%)      73 (10.8%)      791 (52.1%)        0 (0.00%)               
## Stay_In_Current_City_Years   1.85 (1.27)     1.84 (1.23)      1.87 (1.31)       1.91 (1.36)      0.864   
## Marital_Status:                                                                                  0.062   
##     0                       1989 (56.9%)     418 (61.7%)      900 (59.3%)       110 (55.3%)              
##     1                       1508 (43.1%)     259 (38.3%)      618 (40.7%)       89 (44.7%)               
## Age_Int                      36.0 (12.4)     33.2 (9.69)      34.9 (11.4)       34.2 (9.97)     <0.001   
## Product_Category_1           7.60 (6.92)     64.7 (29.4)      30.1 (18.2)       112 (35.2)       0.000   
## Product_Category_2           1.28 (1.87)     10.9 (6.49)      4.78 (4.12)       22.1 (9.14)      0.000   
## Product_Category_3           1.39 (2.65)     8.38 (7.13)      4.13 (5.25)      15.3 (10.00)      0.000   
## Product_Category_4           0.71 (1.53)     5.19 (4.81)      2.24 (3.02)       10.9 (7.35)      0.000   
## Product_Category_5           9.25 (9.07)     66.8 (32.9)      29.7 (21.6)       130 (43.8)       0.000   
## Product_Category_6           1.28 (1.81)     8.75 (5.07)      4.18 (3.73)       17.2 (8.14)      0.000   
## Product_Category_7           0.21 (0.77)     1.70 (2.82)      0.73 (1.58)       3.32 (3.98)     <0.001   
## Product_Category_8           7.14 (6.87)     48.9 (28.2)      22.2 (16.9)       102 (48.4)       0.000   
## Product_Category_9           0.02 (0.13)     0.20 (0.40)      0.09 (0.29)       0.33 (0.47)     <0.001   
## Product_Category_10          0.37 (0.88)     1.97 (1.96)      1.13 (1.57)       3.53 (2.65)      0.000   
## Product_Category_11          1.42 (4.13)     10.8 (13.1)      4.21 (7.59)       26.4 (20.7)      0.000   
## Product_Category_12          0.27 (0.92)     1.68 (2.28)      0.74 (1.47)       3.35 (3.42)     <0.001   
## Product_Category_13          0.29 (0.76)     2.52 (2.20)      1.11 (1.52)       5.11 (3.18)      0.000   
## Product_Category_14          0.08 (0.33)     0.65 (1.08)      0.29 (0.68)       1.66 (1.81)     <0.001   
## Product_Category_15          0.36 (0.85)     2.73 (2.55)      1.29 (1.85)       5.68 (3.83)      0.000   
## Product_Category_16          0.62 (0.99)     4.26 (3.73)      1.65 (2.07)       10.7 (7.05)      0.000   
## Product_Category_17          0.03 (0.21)     0.27 (0.69)      0.10 (0.39)       0.55 (0.93)     <0.001   
## Product_Category_18          0.15 (0.66)     1.50 (2.24)      0.57 (1.35)       3.36 (3.15)     <0.001   
## Purchase                   310419 (165500) 2213471 (428923) 1049981 (267304) 4219815 (1008682)   0.000   
## cluster_kmeans:                                                                                  0.000   
##     1                        16 (0.46%)      470 (69.4%)      522 (34.4%)       11 (5.53%)               
##     2                        64 (1.83%)      117 (17.3%)      138 (9.09%)        5 (2.51%)               
##     3                       3417 (97.7%)      10 (1.48%)      858 (56.5%)        0 (0.00%)               
##     4                         0 (0.00%)       80 (11.8%)       0 (0.00%)        183 (92.0%)              
## ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

K-medoids distancia Gower

(https://www.rdocumentation.org/packages/StatMatch/versions/1.2.0/topics/gower.dist) (https://towardsdatascience.com/clustering-on-mixed-type-data-8bbd0a2569c3) La distancia Gower permite trabajar con datos tanto categóricos como continuos.

Crea una matriz de disimilitud basada en la media de distancias parciales (cada atributo) entre individuos. Según el tipo de variable, la distancia parcial se calcula con una fórmula distinta.

Para variables categóricas la distancia es 0 si el valor es igual y 1 si son distintas. Para variables numéricas se usa la diferencia en valor absoluto dividida por el mayor rango de la variable.

La distancia Gower funciona bien con el algoritmo PAM (Partitioning around mediods). PAM es parecido a K-means, pero los centros de cada cluster en vez de ser centroides de medias definidas por distancia Euclidea, son directamente ciertos individuos (medoids). Esto es útil para la interpretación ya que el centro representa un “individuo típico” de cada cluster. Sin embargo, este método requiere más tiempo y cálculo (orden cuadrático)

BlackFriday_pam <- subset( BlackFriday_Clustering, select = -c(cluster_kmeans,cluster_kproto) )
head(BlackFriday_pam)

Calculamos la matriz de distancias gower con la función daisy

gower_dist <- daisy(BlackFriday_pam, metric = "gower")
## Warning in daisy(BlackFriday_pam, metric = "gower"): binary variable(s) 15
## treated as interval scaled
gower_mat <- as.matrix(gower_dist)

Para comprobar que la distancia gower se calcula correctamente, la matriz nos permite obtener, por ejemplo, los clientes más y menos similares

# Clientes más parecidos
BlackFriday_pam[which(gower_mat == min(gower_mat[gower_mat != min(gower_mat)]), arr.ind = TRUE)[1, ], ]
# Clientes menos parecidos
BlackFriday_pam[which(gower_mat == max(gower_mat[gower_mat != max(gower_mat)]), arr.ind = TRUE)[1, ], ]

Para calcular el número óptimo de clusters en este caso, usamos el que tenga mayor silhouette width, que mide la similitud de un objeto con su cluster comparado con los demás

sil_width <- c(NA)
for(i in 2:8){  
  pam_fit <- pam(gower_dist, diss = TRUE, k = i)  
  sil_width[i] <- pam_fit$silinfo$avg.width  
}
plot(1:8, sil_width,
     xlab = "Number of clusters",
     ylab = "Silhouette Width")
lines(1:8, sil_width)

El mayor valor de silhouette width se da con 2 clusters, pero elegimos 3 ya que tiene un valor parecido y nos puede aportar más información.

Visualizamos la representación en 2D

pam_fit <- pam(gower_dist, diss = TRUE, k = 3) 
tsne_obj <- Rtsne(gower_dist, is_distance = TRUE)
tsne_data <- tsne_obj$Y %>%
  data.frame() %>%
  setNames(c("X", "Y")) %>%
  mutate(cluster = factor(pam_fit$clustering))
ggplot(aes(x = X, y = Y), data = tsne_data) +
  geom_point(aes(color = cluster))

Creamos columna de cluster_pam

BlackFriday_Clustering$cluster_pam <- as.factor(pam_fit$clustering)

Análisis de resultados

Con este resultado se obtienen diferencias en los clusters en un mayor número de variables, y los clusters son de un tamaño similar.

Hay algunas variables sobre las que no se aprecian diferencias significativos entre los clusters al tener medias y distribuciones parecidas: - Stay_In_Current_City_Years: Media 1.8 años - Gender: 70% Hombre - Product_Category: Todos compran mayormente productos tipo 1, 5, 8. Solo el cluster 3 destaca por tener un volumen de compra mayor de estos productos

Se pueden observar algunas características interesantes de cada cluster:

  • Cluster 1: Gasto medio 535, Mayoría ciudad C, Edad media 32, Ocupación mayoritaria 0, Estado civil 0
  • Cluster 2: Gasto medio 602, Mayoría ciudad C, Edad media 41, Ocupación mayoritaria 7, Estado civil 1
  • Cluster 3: Gasto medio mayor (1580), Mayoría ciudad B, Edad media 31, Ocupación mayoritaria 4, Estado civil 0
clusterAnalysis(BlackFriday_Clustering,'cluster_pam')
## 
## --------Summary descriptives table by 'cluster_pam'---------
## 
## ______________________________________________________________________________________ 
##                                   1               2                3         p.overall 
##                                N=2200          N=2040           N=1651                 
## ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ 
## Gender:                                                                        0.113   
##     F                        644 (29.3%)     587 (28.8%)      435 (26.3%)              
##     M                       1556 (70.7%)    1453 (71.2%)     1216 (73.7%)              
## Occupation:                                                                      .     
##     0                        493 (22.4%)     95 (4.66%)       100 (6.06%)              
##     1                        186 (8.45%)     205 (10.0%)      126 (7.63%)              
##     2                        80 (3.64%)      92 (4.51%)       84 (5.09%)               
##     3                        49 (2.23%)      69 (3.38%)       52 (3.15%)               
##     4                        207 (9.41%)     102 (5.00%)      431 (26.1%)              
##     5                        35 (1.59%)      36 (1.76%)       40 (2.42%)               
##     6                        61 (2.77%)      109 (5.34%)      58 (3.51%)               
##     7                        136 (6.18%)     425 (20.8%)      108 (6.54%)              
##     8                        10 (0.45%)       5 (0.25%)        2 (0.12%)               
##     9                        28 (1.27%)      41 (2.01%)       19 (1.15%)               
##     10                       141 (6.41%)      7 (0.34%)       44 (2.67%)               
##     11                       42 (1.91%)      45 (2.21%)       41 (2.48%)               
##     12                       149 (6.77%)     128 (6.27%)      99 (6.00%)               
##     13                       37 (1.68%)      88 (4.31%)       15 (0.91%)               
##     14                       94 (4.27%)      125 (6.13%)      75 (4.54%)               
##     15                       43 (1.95%)      55 (2.70%)       42 (2.54%)               
##     16                       68 (3.09%)      108 (5.29%)      59 (3.57%)               
##     17                       204 (9.27%)     172 (8.43%)      115 (6.97%)              
##     18                       27 (1.23%)      28 (1.37%)       12 (0.73%)               
##     19                       37 (1.68%)      12 (0.59%)       22 (1.33%)               
##     20                       73 (3.32%)      93 (4.56%)       107 (6.48%)              
## City_Category:                                                                 0.000   
##     A                        358 (16.3%)     322 (15.8%)      365 (22.1%)              
##     B                        137 (6.23%)     335 (16.4%)     1235 (74.8%)              
##     C                       1705 (77.5%)    1383 (67.8%)      51 (3.09%)               
## Stay_In_Current_City_Years   1.71 (1.30)     1.94 (1.26)      1.96 (1.27)     <0.001   
## Marital_Status:                                                                0.000   
##     0                       2047 (93.0%)     112 (5.49%)     1258 (76.2%)              
##     1                        153 (6.95%)    1928 (94.5%)      393 (23.8%)              
## Age_Int                      32.7 (11.4)     41.3 (11.5)      31.6 (9.77)     <0.001   
## Product_Category_1           15.2 (19.3)     16.1 (22.1)      43.7 (38.1)     <0.001   
## Product_Category_2           2.34 (3.63)     2.65 (4.29)      7.85 (8.01)     <0.001   
## Product_Category_3           2.30 (4.28)     2.06 (3.86)      6.41 (7.31)     <0.001   
## Product_Category_4           1.24 (2.54)     1.21 (2.43)      3.87 (5.06)     <0.001   
## Product_Category_5           15.3 (19.6)     16.9 (23.4)      48.7 (43.8)     <0.001   
## Product_Category_6           2.09 (3.24)     2.39 (3.69)      6.49 (6.27)     <0.001   
## Product_Category_7           0.35 (1.26)     0.43 (1.31)      1.22 (2.39)     <0.001   
## Product_Category_8           11.0 (14.8)     14.0 (20.6)      35.9 (35.6)     <0.001   
## Product_Category_9           0.04 (0.19)     0.05 (0.21)      0.14 (0.34)     <0.001   
## Product_Category_10          0.49 (1.04)     0.71 (1.40)      1.51 (1.95)     <0.001   
## Product_Category_11          2.42 (5.87)     2.46 (6.54)      8.24 (13.5)     <0.001   
## Product_Category_12          0.33 (0.98)     0.55 (1.46)      1.22 (2.13)     <0.001   
## Product_Category_13          0.52 (1.16)     0.69 (1.48)      1.74 (2.27)     <0.001   
## Product_Category_14          0.14 (0.48)     0.18 (0.60)      0.49 (1.03)     <0.001   
## Product_Category_15          0.62 (1.29)     0.74 (1.61)      2.01 (2.68)     <0.001   
## Product_Category_16          0.95 (1.76)     1.18 (2.30)      3.14 (4.34)     <0.001   
## Product_Category_17          0.04 (0.25)     0.09 (0.37)      0.18 (0.56)     <0.001   
## Product_Category_18          0.25 (0.82)     0.42 (1.38)      1.01 (1.98)     <0.001   
## Purchase                   535615 (525969) 602529 (653107) 1580956 (1212211)   0.000   
## cluster_kmeans:                                                               <0.001   
##     1                        182 (8.27%)     213 (10.4%)      624 (37.8%)              
##     2                        80 (3.64%)      82 (4.02%)       162 (9.81%)              
##     3                       1922 (87.4%)    1713 (84.0%)      650 (39.4%)              
##     4                        16 (0.73%)      32 (1.57%)       215 (13.0%)              
## cluster_kproto:                                                                0.000   
##     1                       1615 (73.4%)    1460 (71.6%)      422 (25.6%)              
##     2                        50 (2.27%)      103 (5.05%)      524 (31.7%)              
##     3                        521 (23.7%)     453 (22.2%)      544 (32.9%)              
##     4                        14 (0.64%)      24 (1.18%)       161 (9.75%)              
## ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

Conclusiones

Usando el algoritmo K-medoids obtenemos un mejor resultado. La partición en clusters es más significativa puesto que se aprecian mayores diferencias entre las características de cada cluster. El peor resultado fue al usar el K-means ya que su aplicación a variables mixtas (categóricas y numéricas) no es directa y la codificación incrementa el número de atributos y su complejidad. Sin embargo, con vistas a categorizar clientes según sus compras (tipo de producto) no se pueden obtener muchas conclusiones ya que existe una gran tendencia de todos los clientes a comprar productos de las categorías 1, 5, y 8. Por lo tanto es díficil discernir grupos que prefieran unas categorías sobre otras. En cuanto al gasto total si se pueden apreciar diferencias, pero no en cuanto a qué compran los clientes. Esto ocurre con otros atributos como la edad, el genéro, o el número de años en la ciudad, ya que tienen un valor muy frecuente en el conjunto de datos que siempre dominan los clusters.